home *** CD-ROM | disk | FTP | other *** search
/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / c / lmiwin.lsp < prev    next >
Encoding:
Text File  |  1988-08-16  |  47.6 KB  |  1,340 lines
  1. ;;; -*- MODE:LISP; BASE:8; IBASE:8; PACKAGE:KERMIT -*-
  2.  
  3.  
  4. ;******************************************************************************
  5. ; Copyright (c) 1984, 1985 by Lisp Machine Inc.
  6. ; Symbolics-specific portions Copyright (c) 1985 by Honeywell, Inc.
  7. ; Permission to copy all or part of this material is granted, provided
  8. ; that the copies are not made or distributed for resale, and the 
  9. ; copyright notices and reference to the source file and the software
  10. ; distribution version appear, and that notice is given that copying is
  11. ; by permission of Lisp Machine Inc.  LMI reserves for itself the 
  12. ; sole commercial right to use any part of this KERMIT/H19-Emulator
  13. ; not covered by any Columbia University copyright.  Inquiries concerning
  14. ; copyright should be directed to Mr. Damon Lawrence at (213) 642-1116.
  15. ;
  16. ; Version Information:
  17. ;      LMKERMIT 1.0     --      Original LMI code, plus edit ;1; for 3600 port
  18. ;
  19. ; Authorship Information:
  20. ;      Mark David (LMI)           Original version, using KERMIT.C as a guide
  21. ;      George Carrette (LMI)      Various enhancements
  22. ;      Mark Ahlstrom (Honeywell)  Port to 3600 (edits marked with ";1;" comments)
  23. ;
  24. ; Author Addresses:
  25. ;      George Carrette     ARPANET: GJC at MIT-MC
  26. ;
  27. ;      Mark Ahlstrom       ARPANET: Ahlstrom at HI-Multics
  28. ;                          PHONE:   (612) 887-4006
  29. ;                          USMAIL:  Honeywell MN09-1400
  30. ;                                   Computer Sciences Center
  31. ;                                   10701 Lyndale Avenue South
  32. ;                                   Bloomington, MN  55420
  33. ;******************************************************************************
  34.  
  35. ;;; This is now the toplevel user interface for
  36. ;;; the kermit system.
  37.  
  38.  
  39. (declare (special self
  40.           kstate            ;in calls.lisp
  41.           kterm-state            ;in term.lisp
  42.           ))
  43.  
  44.  
  45. ;1; This is where the version string is defined!
  46. ;1; It's display is handled by the terminal-pane-label below.
  47.  
  48. (defconst kermit-version "LMKERMIT Version 1.0a Alpha Test")
  49.  
  50. (defvar kermit-frame :unbound
  51.   "Frame for KERMIT")
  52.  
  53.  
  54. (defvar status-pane :unbound
  55.   "Status pane in KERMIT frame")
  56.  
  57.  
  58. (defvar interaction-pane :unbound
  59.   "Interaction pane in KERMIT frame")
  60.  
  61.  
  62. ;;; (actually just the interaction pane)
  63. (defvar debug-pane :unbound
  64.   "Debugging pane in KERMIT frame")
  65.  
  66.  
  67. (defvar command-pane :unbound "Pane for menu commands")
  68.  
  69.  
  70. (defvar terminal-pane :unbound
  71.   "Terminal emmulation pane in kermit for connecting to remote host
  72.    The terminal emulated is a HEATH (or H19) type terminal.")
  73.  
  74.  
  75.  
  76. (defconst terminal-pane-label
  77.             `(:string ,(format nil "H-19//Z-29 Terminal Emulator -- ~A" kermit-version)    ;1;
  78.                          ,@(if (boundp 'fonts:metsi) (list :font fonts:metsi))
  79.                          #-3600 :centered))    ;1; :centered is not known keyword on 3600
  80.  
  81.  
  82. (defconst interaction-pane-label
  83.             `(:string "Interaction Pane"
  84.                          ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi))
  85.                         #-3600 :centered))
  86.  
  87. (defconst command-pane-label
  88.             `(:string "Commands"
  89.                          ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi))
  90.                         #-3600 :centered))
  91.  
  92.  
  93. (defconst status-pane-label
  94.             `(:string "Kermit"            ;this is just the top level
  95.                         ;waiting for a command label!
  96.                          ,@(if (boundp 'fonts:hl12bi) (list :font fonts:hl12bi))
  97.                         #-3600 :centered))
  98.  
  99.  
  100.  
  101.  
  102. ;;;------------------------------------------------------------
  103.  
  104. ;;;;  K E R M I T   F R A M E
  105.  
  106. ;1; The next few were added for the 3600 version.
  107.  
  108. ;#+3600
  109. ;(defvar *kermit-modem-phone-number* 98706086.
  110. ;  "The phone number for the Symbolics modem to dial upon opening the serial stream.")
  111.  
  112. #+3600
  113. (defvar *kermit-default-baud-rate* 9600.
  114.   "The baud rate at which the generalized ports will be originally opened.
  115.    Of course, you can change the rate after the stream is open using the
  116.    Change Baud Rate command from the command menu.")
  117.  
  118. ;1; I originally thought I needed to use ascii-translation character streams, but
  119. ;1; you don't.  The kermit stuff does its own character translation as needed.
  120. #+3600
  121. (defvar *kermit-serial-stream-open-form-list*
  122.     `(
  123.  
  124. ;         ("Internal Modem"            
  125. ;          (or (aref si:*serial-streams* 2)    ;1; if already open,just return the stream....
  126. ;          (si:make-serial-stream :flavor 'si:modem
  127. ;                     :phone-number ,*kermit-modem-phone-number*
  128. ;                     :unit 2 :baud 1200. 
  129. ;                     :force-output t)))
  130.  
  131.       ("Port 1" 
  132.        (or (aref si:*serial-streams* 1)
  133.            (si:make-serial-stream :unit 1 
  134.                       :force-output t
  135.                       :baud ,*kermit-default-baud-rate*)))
  136.       ("Port 1 with flow control" 
  137.        (or (aref si:*serial-streams* 1)
  138.            (si:make-serial-stream :unit 1 
  139.                       :force-output t
  140.                       :xon-xoff-protocol t
  141.                       :generate-xon-xoff t
  142.                       :baud ,*kermit-default-baud-rate*)))
  143.       ("Port 2"
  144.        (or (aref si:*serial-streams* 2)
  145.            (si:make-serial-stream :unit 2 
  146.                       :force-output t
  147.                       :baud ,*kermit-default-baud-rate*)))
  148.       ("Port 2 with flow control" 
  149.        (or (aref si:*serial-streams* 2)
  150.            (si:make-serial-stream :unit 2 
  151.                       :force-output t
  152.                       :xon-xoff-protocol t
  153.                       :generate-xon-xoff t
  154.                       :baud ,*kermit-default-baud-rate*)))
  155.       ("Port 3"
  156.        (or (aref si:*serial-streams* 3)
  157.            (si:make-serial-stream :unit 3 
  158.                       :force-output t
  159.                       :baud ,*kermit-default-baud-rate*)))
  160.       ("Port 3 with flow control" 
  161.        (or (aref si:*serial-streams* 3)
  162.            (si:make-serial-stream :unit 3 
  163.                       :force-output t
  164.                       :xon-xoff-protocol t
  165.                       :generate-xon-xoff t
  166.                       :baud ,*kermit-default-baud-rate*)))
  167.       )
  168.   "The list of name-form pairs available for use in opening the serial stream.")
  169.  
  170. (defconst *default-serial-stream-open-form*
  171.             #-3600                ;1; 3600 does not have select-processor
  172.             (select-processor
  173.               (:cadr '(make-serial-stream))
  174.               (:lambda '(open "SDU-SERIAL-B:"
  175.                                   ;; might not lose as badly with bigger buffers:
  176.                                   :input-buffer-size (* 3 si:page-size)
  177.                                   :output-buffer-size (* 2 si:page-size)))
  178.               (:explorer '(make-serial-stream-perhaps)))
  179.             #+3600
  180.             (cadr (first *kermit-serial-stream-open-form-list*))    ;1; Port 1 is the default.
  181.         )
  182.  
  183. (defvar kermit-serial-stream :unbound
  184.   "Special instance var of kermit-frame bound to serial stream or nil inside process.")
  185.  
  186. (defvar kermit-ready-for-commands? :unbound
  187.   "Nil means data structures unitialized or invalid.")
  188.  
  189. (defvar kermit-connected-flag :unbound
  190.   "Non-nil means locked into terminal CONNECTion.")
  191.  
  192. (defflavor kermit-frame
  193.  
  194.              ((kermit-ready-for-commands? nil)
  195.               (kermit-connected-flag nil)
  196.               (kermit-serial-stream nil)
  197.               (serial-stream-open-form *default-serial-stream-open-form*)
  198.               kstate kterm-state
  199.               )
  200.  
  201.              (
  202.           #+3600 tv:window-with-typeout-mixin    ;1; needed for with-kermit-typeout-stream
  203.           tv:process-mixin
  204.               tv:select-mixin                     ; just to get :set-process handler!
  205. #-3600        tv:inferiors-not-in-select-menu-mixin    ;1; not for 3600
  206. #-3600        tv:alias-for-inferiors-mixin
  207.               tv:margin-choice-mixin tv:essential-mouse     ;for asynchronous mouse cmds
  208. #+3600        tv:stream-mixin            ;1; needed for 3600 to get :listen, etc.
  209.               tv:bordered-constraint-frame-with-shared-io-buffer)
  210.  
  211.   :SPECIAL-INSTANCE-VARIABLES
  212.   :initable-instance-variables            ;1; changed inittable to initable, typo?
  213.   :outside-accessible-instance-variables    ;1; why??
  214.   (:accessor-prefix "")
  215.  
  216.   (:documentation
  217.     :special-purpose
  218.     "kermit command and terminal frame for file transfer and remote terminal emulation")
  219.  
  220.   (:default-init-plist
  221.  
  222.    #+3600 :typeout-window #+3600 '(tv:typeout-window)    ;1; for with-kermit-typeout-stream
  223.  
  224.     :margin-choices '((" Abort " nil async-abort 0 0)
  225.                           (" Exit " nil async-exit 0 0)
  226.                           (" Break " nil async-break 0 0)
  227.                           (" Resume " nil async-resume 0 0))
  228.  
  229.     :borders 3                                              ; 3 on frame + 3 on each pane
  230.  
  231.     :expose-p t                                             ; expose w/o blink on instantiation
  232.     :activate-p t                                 ; activate on instantiation
  233.     :save-bits :delayed                           ; make save bits array on deexposure
  234.     :process '(run-kermit-process)
  235.  
  236.     :panes
  237.     `((status-pane kermit-status-pane)
  238.       (command-pane kermit-command-pane)
  239.       (interaction-pane kermit-interaction-pane)
  240.       (extra-pane kermit-status-pane)        ;1; What is this pane for??
  241.       . ((terminal-pane kermit-terminal-pane)))
  242.  
  243.     ;1; Yup, As of release 6.0, the 3600 is going to a different way of
  244.     ;1; specifying constraints...
  245.     #-3600
  246.     :constraints
  247.     #-3600
  248.     '((default
  249.           . ((top-strip terminal-pane interaction-pane)
  250.              ((top-strip
  251.                 :horizontal (:ask-window command-pane :pane-size)
  252.                 . ((status-pane command-pane)
  253.                      ((command-pane :ask :pane-size))
  254.                      ((status-pane :even)))))
  255.              ((terminal-pane 25. :lines))
  256.              ((interaction-pane :even))))
  257.       ;1; next one reduces size of the interaction pane to give a larger
  258.       ;1; landscape terminal window.
  259.       (long-terminal
  260.       . ((top-strip terminal-pane interaction-pane)
  261.              ((top-strip
  262.                 :horizontal (:ask-window command-pane :pane-size)
  263.                 . ((status-pane command-pane)
  264.                      ((command-pane :ask :pane-size))
  265.                      ((status-pane :even)))))
  266.              ((terminal-pane 50. :lines))    ;1; 3640 has smaller screen, can't handle 50.
  267.              ((interaction-pane :even))))
  268.       )
  269.  
  270.     ;1; This is the new way for 3600... rather nice, actually...
  271.     #+3600
  272.     :configurations
  273.     #+3600
  274.     '((default
  275.     (:layout
  276.      (default :column top-strip terminal-pane interaction-pane)
  277.      (top-strip :row status-pane command-pane))
  278.     (:sizes
  279.      (default (top-strip :ask-window command-pane :pane-size)
  280.           :then (terminal-pane 25. :lines)
  281.           :then (interaction-pane :even))
  282.      (top-strip (command-pane :ask :pane-size)
  283.             :then (status-pane :even))))
  284.  
  285.       (long-terminal                ;actually, this is a large landscape...
  286.     (:layout
  287.      (long-terminal :column top-strip terminal-pane interaction-pane)
  288.      (top-strip :row status-pane command-pane))
  289.     (:sizes
  290.      (long-terminal (top-strip :ask-window command-pane :pane-size)
  291.           :then (interaction-pane 3. :lines)
  292.           :then (terminal-pane :even))    ;make terminal pane as large as possible
  293.      (top-strip (command-pane :ask :pane-size)
  294.             :then (status-pane :even))))
  295.  
  296.       (portrait-terminal            ;and this new one is a long, 80 char portrait
  297.     (:layout
  298.      (portrait-terminal :row terminal-pane totem-pane)
  299.      (totem-pane :column command-pane status-pane interaction-pane))
  300.     (:sizes
  301.      (portrait-terminal (terminal-pane 80. :characters)
  302.                 :then (totem-pane :even))
  303.      (totem-pane (command-pane :ask :pane-size)
  304.              :then (status-pane 0.5)
  305.              :then (interaction-pane :even)))))
  306.     ))
  307.  
  308.  
  309.  
  310.  
  311.  
  312.  
  313. (defmethod (kermit-frame :before :select)
  314.              (&optional ignore)            ;1; added the &optional so it would work
  315.   (fs:force-user-to-login)            ;1; with no arguments.
  316.   ;1; I had to add the following to ensure that kstate would be bound before
  317.   ;1; we try to send it a message.  If not, I got an unbound error upon initial invocation.
  318.   #+3600 (make-kermit-ready-for-commands)
  319.   ;1; Oh boy, did this cause me grief... it doesn't do at all what I want on 3600...
  320.   ;1; Having this here makes it almost impossible to keep a non-default pathname
  321.   ;1; set without having it reset to the default!
  322.   #-3600 (send kstate :set-kermit-default-pathname (string (fs:user-homedir)))
  323.   )
  324.  
  325. ;;;; scrolling mixin
  326. ;;; this should be part of the general system, but alot of people flame
  327. ;;; at the idea, so...
  328.  
  329. (defflavor scrolling-mixin
  330.              ((scroll-p t)
  331.               (smooth-scroll-p nil))
  332.              ()
  333.   (:required-flavors tv:minimum-window)
  334.   (:init-keywords :scroll-p :smooth-scroll-p)
  335.   :settable-instance-variables
  336.   :gettable-instance-variables
  337.   (:default-init-plist
  338.     :scroll-p t
  339.     :smooth-scroll-p nil))
  340.  
  341. ;1; On 3600, we must now do this with a defwhopper (or defwrapper)
  342. #-3600
  343. (defmethod (scrolling-mixin :around :end-of-page-exception)
  344.              (cont mt original-argument-list &rest args)
  345.   original-argument-list
  346.   (cond ((or scroll-p smooth-scroll-p)
  347.            (multiple-value-bind (ignore y)
  348.                (send self :read-cursorpos :character)
  349.              (send self :set-cursorpos 0 0 :character)
  350.              ;; should have an option and a terminal escape for this
  351.              ;; and should be able to vary from line to smooth scrolling
  352.              ;; from terminal.
  353.              (cond (smooth-scroll-p (send self :smooth-delete-line))
  354.                      (t (send self :delete-line)))
  355.              (send self :set-cursorpos 0 (1- y) :character))
  356.            (setf (tv:sheet-end-page-flag self) 0)
  357.            (setf (tv:sheet-more-flag self) 0))
  358.           (t (lexpr-funcall-with-mapping-table cont mt :end-of-page-exception args))))
  359.  
  360. #+3600
  361. (defwhopper (scrolling-mixin :end-of-page-exception) (&rest args)
  362.   (cond ((or scroll-p smooth-scroll-p)
  363.            (multiple-value-bind (ignore y)
  364.                (send self :read-cursorpos :character)
  365.              (send self :set-cursorpos 0 0 :character)
  366.              ;; should have an option and a terminal escape for this
  367.              ;; and should be able to vary from line to smooth scrolling
  368.              ;; from terminal.
  369.              (cond (smooth-scroll-p (send self :smooth-delete-line))
  370.                      (t (send self :delete-line)))
  371.              (send self :set-cursorpos 0 (1- y) :character))
  372.            (setf (tv:sheet-end-page-flag self) 0)
  373.            (setf (tv:sheet-more-flag self) 0))
  374.           (t (lexpr-continue-whopper args))))
  375.  
  376. (defmethod (scrolling-mixin :smooth-delete-line) ()
  377.   (let ((line-height (tv:sheet-line-height self)))
  378.     (loop for i from 1 to line-height by 1
  379.             do #+3600 (send self :delete-line 1 ':pixel)    ;1;
  380.            #-3600 (tv:sheet-delete-line self 1 :pixel))))
  381.  
  382. #-3600
  383. (tv:add-escape-key #/R
  384.                        'kbd-escape-scroll
  385.                        "terminal r -- toggle scrolling off, on, on-smooth
  386. terminal 0 r -- turn off scrolling
  387. terminal 1 r -- turn on scrolling
  388. terminal 2 r -- turn on smooth scrolling")
  389.  
  390. #+3600
  391. (tv:add-function-key #\scroll
  392.                        'kbd-escape-scroll
  393.                        "Function Scroll - turns scrolling off, on, on-smooth (like for Kermit terminal)
  394.                        function 0 scroll -- turn off scrolling
  395.                        function 1 scroll -- turn on scrolling
  396.                        function 2 scroll -- turn on smooth scrolling")
  397.  
  398. (defun kbd-escape-scroll (arg)
  399.   (let ((window? tv:selected-window))
  400.     (and window?
  401.            (memq :set-scroll-p (send window? :which-operations))
  402.            (memq :set-smooth-scroll-p (send window? :which-operations))
  403.            (select arg
  404.              (nil (cond ((send window? :smooth-scroll-p)
  405.                            ;; go to no scroll
  406.                            (send window? :set-scroll-p nil)
  407.                            (send window? :set-smooth-scroll-p nil))
  408.                           ((send window? :scroll-p)
  409.                            ;; go to smooth-scroll
  410.                            (send window? :set-smooth-scroll-p t))
  411.                           (t
  412.                            ;; go to scroll
  413.                            (send window? :set-scroll-p t)
  414.                            (send window? :set-smooth-scroll-p nil))))
  415.              (0 (send window? :set-scroll-p nil)
  416.                 (send window? :set-smooth-scroll-p nil))
  417.              (1 (send window? :set-scroll-p t)
  418.                 (send window? :set-smooth-scroll-p nil))
  419.              (2 (send window? :set-scroll-p t)
  420.                 (send window? :set-smooth-scroll-p t))))))
  421.  
  422.  
  423.  
  424. ;1; also need to define these needed methods for kermit frame so scrolling will work
  425. ;1; Note that currently, scrolling is only for the interaction pane.
  426.  
  427. #+3600
  428. (defmethod (kermit-frame :scroll-p) ()
  429.   (send interaction-pane :scroll-p))
  430. #+3600
  431. (defmethod (kermit-frame :smooth-scroll-p) ()
  432.   (send interaction-pane :smooth-scroll-p))
  433. #+3600
  434. (defmethod (kermit-frame :set-scroll-p) (val)
  435.   (send self :send-all-panes :send-if-handles :set-scroll-p val))
  436. #+3600
  437. (defmethod (kermit-frame :set-smooth-scroll-p) (val)
  438.   (send self :send-all-panes :send-if-handles :set-smooth-scroll-p val))
  439.  
  440. (defflavor kermit-interaction-pane ()
  441.  
  442.              (tv:notification-mixin
  443. #-3600        tv:list-mouse-buttons-mixin      ;1; not needed (or defined) on 3600.
  444.               scrolling-mixin                     ;the hack above
  445.                                                             ;(which strangely is not in the system)
  446.               tv:window)
  447.  
  448.   (:documentation
  449.     :special-purpose
  450.     "Kermit interaction pane")
  451.  
  452.   (:default-init-plist
  453.  
  454.     :blinker-p t
  455.  
  456.     :borders 3                                              ; 3 on frame + 3 on each pane
  457.  
  458.     :reverse-video-p t
  459.     :save-bits :delayed
  460.     :more-p nil
  461.     #+3600 :smooth-scroll-p #+3600 t        ;1; I like it, and it gives you time to read it.
  462.     :label interaction-pane-label
  463.  
  464.     :deexposed-typeout-action :permit
  465.  
  466.     :font-map '(medfnb)
  467.     :vsp 3                                                  ; 3 pixels between lines
  468.     :right-margin-character-flag 1))
  469.  
  470.  
  471.  
  472.  
  473.  
  474. (defflavor kermit-status-pane ()
  475.              (
  476. #-3600          tv:list-mouse-buttons-mixin      ;1; not for 3600
  477.               tv:top-label-mixin
  478.               tv:window)
  479.   (:documentation
  480.     :special-purpose
  481.     "Kermit status pane")
  482.  
  483.   (:default-init-plist
  484.  
  485.     :borders 3                                              ; 3 on frame + 3 on each pane
  486.  
  487.     :font-map '(fonts:medfnt)
  488.     :vsp 3                                                  ; 5 pixels between lines
  489.     :more-p nil
  490.     :deexposed-typeout-action :permit
  491.     :save-bits :delayed
  492.     :reverse-video-p t
  493.     :label status-pane-label
  494.     :blinker-p nil                                ; no blinker
  495.     ))
  496.  
  497.  
  498. (defflavor kermit-command-pane ()
  499.              (tv:top-label-mixin
  500.               tv:menu-highlighting-mixin
  501.               tv:command-menu)
  502.   (:documentation
  503.     :special-purpose
  504.     "Kermit Command Pane")
  505.  
  506.   (:default-init-plist
  507.     :borders 3                                              ; 3 on frame + 3 on each pane
  508.     :label command-pane-label
  509.     :columns 2
  510.     :save-bits :delayed
  511.     :rows 10                                                ; if more items, they can be 'scrolled' to.
  512.     :reverse-video-p t
  513.     :default-font fonts:hl12bi
  514.     :item-list all-kermit-command-pane-items))
  515.  
  516. ;1; I see what this does, but it doesn't work on 3600, and it is
  517. ;1; just too hairy to handle right now.
  518. ;1; After I get the basic stuff working, I can do this using
  519. ;1; a defwhopper.
  520. ;1; Actually, the normal menu selection seems ok, so I probably
  521. ;1; will not worry about this.
  522. #-3600
  523. (defmethod (kermit-command-pane :around :execute)
  524.              (cont mt original-argument-list item)
  525.   original-argument-list
  526.   (unwind-protect
  527.       (progn (send self :add-highlighted-item item)
  528.                (funcall-with-mapping-table cont mt :execute item))
  529.     (send self :remove-highlighted-item item)))
  530.  
  531.  
  532.  
  533.  
  534.  
  535.  
  536. ;; code for terminal in "kermit; term.lisp".
  537. ;1; Note that the terminal does not use the scrolling-mixin stuff
  538. ;1; since it handles its own display explicitly.
  539.  
  540. (defflavor kermit-terminal-pane ()
  541.  
  542.              (tv:notification-mixin
  543.               #-3600 tv:box-label-mixin #+3600 tv:top-box-label-mixin    ;1;
  544. #-3600        tv:list-mouse-buttons-mixin    ;1; not for 3600
  545.               tv:window)
  546.  
  547.  
  548.   (:documentation
  549.     :special-purpose
  550.     "A general Heath/Zenith terminal emulator for the Lisp Machine")
  551.  
  552.   (:default-init-plist
  553.     :more-p nil
  554.     #-3600 :label-box-p #-3600 t
  555.     :border-margin-width 3
  556.     :borders 3
  557.     :label terminal-pane-label
  558.     :font-map '(fonts:cptfont)
  559.     :save-bits :delayed
  560.     :deexposed-typeout-action :permit
  561.     :vsp 1
  562.     :character-height 26.                         ;1+ standard # of lines (25 for Heath/Zenith)
  563.     ))
  564.  
  565.  
  566.  
  567.  
  568. ;1; This is where the kermit program is "put into the system" for selection, etc.
  569.  
  570. ;1; The kermit frame will show up in the select system window.
  571. ;1; Since we don't want individual panes to show up in the menu,
  572. ;1; we will define the following method so only the frame will appear.
  573.  
  574. #+3600
  575. (defmethod (kermit-frame :selectable-windows) ()
  576.   `((,(send self :name-for-selection) ,self)))
  577.  
  578. ;1; We will also have kermit selectable using the select key on "select K".
  579.  
  580. (tv:add-system-key #\K 'kermit-frame "Kermit" t)
  581.  
  582. ;1; We might as well have it show up on the create system menu, too.
  583.  
  584. #+3600
  585. (tv:add-to-system-menu-create-menu
  586.   "Kermit" 'kermit-frame "The Kermit file transfer and terminal emulation frame.")
  587.  
  588. ;1; And also add it to the right column of the system menu.
  589.  
  590. #+3600
  591. (tv:add-to-system-menu-programs-column
  592.   "Kermit"
  593.   '(tv:select-or-create-window-of-flavor 'kermit-frame)
  594.   "The Kermit file transfer and terminal emulation frame.")
  595.  
  596. ;;;; this is a very important thing to do unless
  597. ;;;; you like to live in the cold load stream:
  598.  
  599. #-3600                        ;1; :set-selection-substitute not handled on 3600...
  600. (defmethod (kermit-frame :after :init) (ignore)
  601.   (send self :set-selection-substitute
  602.           (send self :get-pane 'interaction-pane)))
  603.  
  604.  
  605.  
  606.  
  607.  
  608.  
  609.  
  610.  
  611. ;;;; Asynchronous wizardry
  612. ;;; New: asynchronous mouse commands. EXPERIMENTAL. --MHD, 6/15/84
  613. ;;; (also see changes to kermit-frame flavor def)
  614.  
  615. (defun async-abort (&rest ignore)
  616.   (format (send self :get-pane 'interaction-pane) "~&[ABORTING..]~%")
  617.   (send (send self :process)
  618.           :interrupt
  619.           (function (lambda () (signal 'sys:abort #-3600 nil)))))    ;1;
  620.  
  621. (defun async-exit (&rest ignore)
  622.   (async-abort)
  623.   (send self :close-serial-stream)
  624.   (send self :bury))
  625.  
  626.  
  627. (defun async-break (&rest ignore)
  628.   (send (send self :process) :interrupt #-3600 #'break #-3600 "Kermit" #+3600 #'dbg))
  629.  
  630.  
  631. ;1; tv:io-buffer-push is not defined on the 3600, so let's try this.
  632. (defun async-resume (&rest ignore &aux
  633.              (buf #-3600 (send (send self :get-pane 'interaction-pane) :io-buffer)
  634.               #+3600 (send self :get-pane 'interaction-pane)
  635.               ))
  636.   #-3600 (tv:io-buffer-push buf #\resume)                ;this doesn't work in the rubout handler!
  637.   #+3600 (send buf :force-kbd-input #\resume)
  638.   )
  639.  
  640. ;;;; Menu
  641.  
  642.  
  643. ;;; for later additions:
  644.  
  645. (defconst aux1-menu-alist ())
  646.  
  647.  
  648. (defun aux1-commands ()
  649. ;;;for now:
  650.   (if aux1-menu-alist
  651.       (tv:menu-choose aux1-menu-alist)
  652.     (format t "~&No Aux1 options available.~%")))
  653.  
  654. ;; could be (is at LMI):
  655. ;           '(("LMI-to-OZ connection"
  656. ;              :funcall kermit-oz-to-lmi-connection
  657. ;              :documentation
  658. ;              "experimental modem & file transfer service between Oz and LMI"
  659. ;              )))
  660.  
  661.  
  662. ;;;; Window Menu Interface
  663. ;;; all items: (<string for menu> :funcall <name of function of no arguments>
  664. ;;;                               :documentation <string>)
  665. ;;; Note: all items beginning with the AUX1 item appear 'below' the menu--
  666. ;;; have to get to them via scroll-bar technology.
  667.  
  668.  
  669. (defconst all-commands-requiring-kermit-serial-stream
  670.             '(make-connection close-connection
  671.               send-files receive-files send-files-to-server receive-files-from-server
  672.               have-server-finish have-server-say-bye
  673.               be-a-kermit-server-only be-a-server
  674.               set-baud-rate                       ;may have to add to this list if you add
  675.                                                             ;to the one right below!
  676.               )
  677.   "Commands that require KERMIT-SERIAL-STREAM to be bound to the apropriate open stream.")
  678.  
  679. (defconst all-kermit-command-pane-items
  680.       '(("Connect" :funcall make-connection
  681.            :documentation "Establish a virtual terminal connection with remote host.")
  682.  
  683.           ("Disconnect" :funcall close-connection
  684.              :documentation "Close the connection made by Connect.")
  685.  
  686.           ("Send files" :funcall send-files
  687.              :documentation "Send files to a remote KERMIT.")
  688.  
  689.           ("Receive files" :funcall receive-files
  690.              :documentation "Receive files from a remote KERMIT.")
  691.  
  692.           ("Server//send" :funcall send-files
  693.              :documentation "Send files to a remote KERMIT that's in Server mode.")
  694.  
  695.           ("Server//receive" :funcall receive-files-from-server
  696.              :documentation "Receive files from a remote KERMIT that's in Server mode.")
  697.  
  698.           ("Server//finish" :funcall finish-server
  699.              :documentation "Finish with KERMIT that's in Server mode, not logging out.")
  700.  
  701.           ("Server//bye" :funcall bye-server
  702.              :documentation "Finish and be logged out by remote KERMIT that's in Server mode.")
  703.  
  704.           ("Set baud rate" :funcall set-baud-rate
  705.              :documentation "Set baud rate of the serial line.")
  706.  
  707.           ("Restart Program" :funcall restart-program
  708.              :documentation "Abandon everything  and start KERMIT from scratch")
  709.  
  710.           ("Review Parameters" :funcall review-parameters
  711.              :documentation "Review parameters, and maybe make modifications")
  712.  
  713.  
  714.           ("Refresh Windows" :funcall refresh-windows
  715.              :documentation "Refresh all the windows in this display.")
  716.  
  717.           ("List directory" :funcall list-user-directory
  718.              :documentation "List the default directory in the interaction pane")
  719.  
  720.  
  721.       ;1; added this command, and put aux commands above remote server
  722.       ;1; commands in anticipation of having aux commands.
  723.       #+3600
  724.       ("Reconfigure Screen" :funcall kermit-reconfigure-screen
  725.        :documentation "Reconfigure the kermit screen display using a menu.")
  726.  
  727.           ("Help" :funcall kermit-interactive-help
  728.            :documentation "Interactive Help with Kermit")
  729.  
  730.           ("AUX1 Commands" :funcall aux1-commands :documentation "extra commands")
  731.  
  732.           ("Remote Login Server"
  733.            :funcall be-a-server
  734.            :documentation "Put Kermit in mode to process remote logins and file transfers.")
  735.  
  736.           ("Remote Kermit Server"
  737.            :funcall be-a-kermit-server-only
  738.            :documentation "Put Kermit directly into  Kermit SERVER Mode.")
  739.       ))
  740.  
  741.  
  742.  
  743.  
  744.  
  745.  
  746.  
  747.  
  748. (defmacro with-status ((status-pane-format-string . format-args?) &body body)
  749.   `(let ((*--old-label--*
  750.              (send status-pane :label)))
  751.      (unwind-protect
  752.            (progn
  753.              (send status-pane
  754.                      :set-label                             ;which may be multi lines.
  755.                      (format nil
  756.                                ,status-pane-format-string
  757.                                . ,format-args?))
  758.              . ,body)
  759.        (send status-pane :set-label *--old-label--*))))
  760.  
  761.  
  762.  
  763. ;1; The menu-based screen reconfiguration command... just 3600 for now.
  764. #+3600
  765. (defun kermit-reconfigure-screen ()
  766.   "Reconfigure the kermit screen characteristics."
  767.   (tv:menu-choose
  768.     '(("Standard 25-line Terminal"
  769.        :eval (progn (send kermit-frame ':set-configuration 'default)
  770.             (refresh-windows))
  771.        :documentation "Goes to the 25-line landscape terminal configuration."
  772.        )
  773.       ("Large Landscape Terminal"
  774.        :eval (progn (send kermit-frame ':set-configuration 'long-terminal)
  775.             (refresh-windows))
  776.        :documentation "Creates as large a landscape configuration as possible."
  777.        )
  778.       ("Large Portrait Terminal"
  779.        :eval (progn (send kermit-frame :set-configuration 'portrait-terminal)
  780.             (refresh-windows))
  781.        :documentation "Creates as large a portrait configuration as possible."
  782.        )
  783.       ("Scrolling Interaction Window"
  784.        :eval (progn (send kermit-frame :set-scroll-p t)
  785.             (send kermit-frame :set-smooth-scroll-p nil))
  786.        :documentation "Have interaction window do standard scrolling."
  787.        )
  788.       ("Smooth Scrolling Interaction Window"
  789.        :eval (progn (send kermit-frame :set-scroll-p t)
  790.             (send kermit-frame :set-smooth-scroll-p t))
  791.        :documentation "Have interaction window do smooth scrolling."
  792.        )
  793.       ("Wrapping Interaction Window"
  794.        :eval (progn (send kermit-frame :set-scroll-p nil)
  795.             (send kermit-frame :set-smooth-scroll-p nil))
  796.        :documentation "Have interaction window wrap to top rather than scroll."
  797.        )
  798.       )
  799.     "Configuration and Scrolling Menu"))
  800.  
  801. ;;;; Help (what?#@#$!!!)
  802. (defun kermit-interactive-help ()
  803.   "Get help interactively; just click on the command to document.
  804. The documentation is then displayed in the interaction pane."
  805.   (with-status ("~&Help with Commands.~A~A"
  806.                     (format nil "~%Please mouse any command")
  807.                     (format nil "~%to see its documentation.~%"))
  808.     (let ((blip? (send terminal-io :any-tyi)))
  809.       (cond ((and (not (atom blip?))
  810.                       (eq (car blip?) :menu))
  811.                (let* ((menu-item-name (car (cadr blip?)))
  812.                         (menu-item-function
  813.                           (get (cadr blip?) :funcall))
  814.                         (documentation?
  815.                           (or (documentation menu-item-function)      ;long doc?
  816.                                 (get (cadr blip?) :documentation))    ;short doc?
  817.                           ))
  818.                  (cond (documentation?
  819.                           (format interaction-pane "~&~A:~%  ~A~%"
  820.                                     menu-item-name
  821.                                     documentation?))
  822.                          (t (format interaction-pane "~&Sorry, ~A is not documented.~%"
  823.                                         menu-item-name)))))
  824.               (t (beep))))))
  825.  
  826.  
  827.  
  828.  
  829.  
  830.  
  831. (defun receive-files-from-server ()
  832.   (cond
  833.     (kermit-connected-flag
  834.      (beep)
  835.      (format t "~%Disconnect first in order to receive.~%"))
  836.     (t
  837.      (let* ((default-pathname (send kstate ':kermit-default-pathname))
  838.         (filename                                     ;don't merge with anything
  839.           (prompt-and-read
  840.         ':string-trim
  841.         "~%Receive file:"))
  842.         ;1; doesn't do it for 3600... Is it really what LMI needs?
  843.         #-3600
  844.         (as-filename
  845.                 (fs:merge-pathname-defaults
  846.                     (prompt-and-read
  847.                       ':string-trim
  848.                       "~%Merging with (default: ~A):"
  849.                       (fs:merge-pathname-defaults filename default-pathname))
  850.                     default-pathname))
  851.         #+3600
  852.         (temp (prompt-and-read
  853.             ':string-trim
  854.             "~%Merging with (default: ~A):"
  855.             (fs:merge-pathname-defaults filename default-pathname)))
  856.         #+3600
  857.         (as-filename
  858.                 (fs:merge-pathname-defaults
  859.                     (cond ((string-equal temp "") filename)
  860.               (t temp))
  861.                     default-pathname))
  862.         )
  863.        (send kstate
  864.                ':server-receive
  865.                kermit-serial-stream
  866.                filename
  867.                as-filename)))))
  868.  
  869.  
  870.  
  871.  
  872. (defun receive-files ()
  873.   (cond
  874.     (kermit-connected-flag
  875.      (beep)
  876.      (format t "~%Disconnect first in order to receive.~%"))
  877.     (t
  878.      (with-status ("Receive:~A ~A ~A"
  879.                        kermit-serial-stream
  880.                        (format nil "~%Transfer started: ~\time\"
  881.                                  (setq *kermit-beginning-time* (time:get-universal-time)))
  882.                        (let ((baud-rate?
  883.                                  (lexpr-send
  884.                                    kermit-serial-stream
  885.                                    :send-if-handles
  886.                                    ;1; changed this part...
  887.                    #-3600 (select-processor
  888.                                      (:lambda (list :baud-rate))
  889.                                      (:cadr (list :get :baud)))
  890.                    #+3600 (list :get :baud)    ;1;
  891.                    )))
  892.                          (if baud-rate?
  893.                                (format nil "~%Baud Rate: ~D." baud-rate?)
  894.                            "")))
  895.        (send kstate
  896.                ':simple-receive
  897.                kermit-serial-stream)))))
  898.  
  899.  
  900. (defun send-files ()
  901.   (cond
  902.     (kermit-connected-flag
  903.      (beep)
  904.      (format t "~%Disconnect first in order to send.~%"))
  905.     (t
  906.      (let* ((default-pathname
  907.                 (send kstate ':kermit-default-pathname))
  908.               (filename
  909.                 (prompt-and-read
  910.                     ':string-trim
  911.                     "~&send file or filegroup (default: ~A):"
  912.                     (fs:merge-pathname-defaults "" default-pathname)))
  913.               (filelist
  914.                 (send kstate
  915.                         ':filelist
  916.                     (fs:merge-pathname-defaults
  917.                       filename
  918.                       default-pathname)))
  919.               (filelist-broken-down-into-from-and-to-filenames
  920.                 (loop for file? in filelist
  921.                         with as-file?
  922.                         with tem
  923.                         nconcing
  924.                         (progn
  925.                           (format t "~&Send ~A as (default: ~A ):"
  926.                                     file? (send kstate
  927.                                                     ':string-for-kermit
  928.                                                     file?))
  929.                           (setq as-file?
  930.                                   (if (zerop (string-length (setq tem (readline))))
  931.                                         (send kstate ':string-for-kermit file?)
  932.                                     tem))
  933.                           (and (y-or-n-p
  934.                                    (format nil "~&Confirm sending ~A as ~A? "
  935.                                              file? as-file?))
  936.                                  (if (string-equal file? as-file?)
  937.                                      (list file?)
  938.                                    (list (list file? as-file?))))))))
  939.        (cond
  940.            (filelist-broken-down-into-from-and-to-filenames
  941.             (with-status ("Send:~A ~A ~A ~%From: ~A"
  942.                               kermit-serial-stream
  943.                               (format nil "~%Transfer started: ~\time\"
  944.                                         (setq *kermit-beginning-time* (time:get-universal-time)))
  945.                               (let ((baud-rate?
  946.                                         (lexpr-send
  947.                                           kermit-serial-stream
  948.                                           :send-if-handles
  949.                       ;1; and changed this too.
  950.                                           #-3600 (select-processor
  951.                                             (:lambda (list :baud-rate))
  952.                                             (:cadr (list :get :baud)))
  953.                       #+3600 (list :get :baud)    ;1;
  954.                       )))
  955.                                 (if baud-rate?
  956.                                     (format nil "~%Baud Rate: ~D." baud-rate?)
  957.                                   ""))
  958.                               filename)
  959.           (format t "~%Starting transfer... hit control-Z to abort.")    ;1; added this...
  960.  
  961.               (send kstate
  962.                       ':simple-send
  963.                       kermit-serial-stream
  964.                       filelist-broken-down-into-from-and-to-filenames)
  965.  
  966. ;1; Changed to correct for bug... only sent first file of wildcard send. Then later removed.
  967. ;1; (This was fixed correctly at another location.  See item #13 in lmbugs.doc
  968. ;1;          (loop for loopfilelist on filelist-broken-down-into-from-and-to-filenames
  969. ;1;            do (send kstate :simple-send kermit-serial-stream loopfilelist))
  970.  
  971.           )))))))
  972.  
  973.  
  974. ;;;; Kermit Server (see the file SERVER for details).
  975. (defun be-a-kermit-server-only ()
  976.   (with-status ("Remote Kermit Server~A~A~A"
  977.                     (format nil "~%Stream: ~A" kermit-serial-stream)
  978.                     (let ((current-baud-rate? (current-baud-rate)))
  979.                       (if current-baud-rate?
  980.                           (format nil
  981.                                     "~%Baud Rate: ~D.~%"
  982.                                     current-baud-rate?)
  983.                         ""))
  984.                     (format nil "~%Use Control-abort key to quit locally."))
  985.     (send kstate
  986.             ':remote-server
  987.             kermit-serial-stream)))
  988.  
  989.  
  990. ;;;; Login Server (see file S-TERM for the details).
  991.  
  992. (defun be-a-server ()
  993.   (with-status ("Login Server ~%Stream: ~A ~A"
  994.                     kermit-serial-stream
  995.                     (let ((current-baud-rate? (current-baud-rate)))
  996.                       (if current-baud-rate?
  997.                           (format nil
  998.                                     "~%Baud Rate: ~D.~%"
  999.                                     current-baud-rate?)
  1000.                         "")))
  1001.     (let ((pst (make-instance 's-terminal:ps-terminal
  1002.                                     :serial kermit-serial-stream
  1003.                                     :peek-chars nil
  1004.                                     :read-ahead-chars nil
  1005.                                     :ttysync t)))
  1006.       (s-terminal:ps-kermit-login pst))))
  1007.  
  1008.  
  1009.  
  1010.  
  1011. ;;;; Close connection.
  1012. ;;; This shuts off the connection in the same way as the user would:
  1013. ;;; by "typing in" the escape sequence (<network>c).
  1014.  
  1015. (defun close-connection ()
  1016.   (with-status ("Turning off Terminal Connection.")
  1017.     (cond (kermit-connected-flag
  1018.              (send terminal-pane :force-kbd-input
  1019.                      #\network)
  1020.              (send terminal-pane :force-kbd-input
  1021.                      #\C)
  1022.              (setf kermit-connected-flag nil))
  1023.             (t (beep)
  1024.                (format interaction-pane "~% ?? You are not connected ??~%")))))
  1025.  
  1026.  
  1027.  
  1028.  
  1029.  
  1030.  
  1031.  
  1032. ;;;; Make connection
  1033. ;;; This is the call to the code in the TERMinal file for terminal emulation.
  1034. ;;; Note that the terminal emulator will intercept and execute command menu mouse
  1035. ;;; blips.
  1036.  
  1037.  
  1038.  
  1039. ;;;; Make connection
  1040. ;;; This is the call to the code in the TERMinal file for terminal emulation.
  1041. ;;; Note that the terminal emulator will intercept and execute command menu mouse
  1042. ;;; blips.
  1043.  
  1044. (defun make-connection ()
  1045.   (cond (kermit-connected-flag
  1046.            (tv:beep)
  1047.            (format interaction-pane "~&YOU ARE ALREADY CONNECTED: DO <NETWORK>C TO DISCONNECT"))
  1048.           (kermit-serial-stream
  1049.            (with-status ("Terminal Connection:~A ~A ~A ~A"
  1050.                            kermit-serial-stream
  1051.                            (format nil "~%Connection started: ~\time\"
  1052.                                      (setq *kermit-beginning-time* (time:get-universal-time)))
  1053.                            (let ((baud-rate?
  1054.                                      (lexpr-send
  1055.                                          kermit-serial-stream
  1056.                                          :send-if-handles
  1057.                      ;1; one more time..
  1058.                                          #-3600(select-processor
  1059.                                            (:lambda (list :baud-rate))
  1060.                                            (:cadr (list :get :baud)))
  1061.                      #+3600 (list :get :baud)
  1062.                      )))
  1063.                                (if baud-rate?
  1064.                                    (format nil "~%Baud Rate: ~D." baud-rate?)
  1065.                                    ""))
  1066.                            (format nil "~%Escape Character: ~:@C"
  1067.                                      #\network    ;fix this!
  1068.                                      ))
  1069.            (unwind-protect
  1070.                (progn (setf kermit-connected-flag t)
  1071.               ;1; again, I will fake this for 3600
  1072.               (cond ((eq (#-3600 tv:with-selection-substitute #-3600 (terminal-pane kermit-frame)
  1073.                   #+3600 let
  1074.                   #+3600 ((terminal-pane (if (boundp 'terminal-pane) terminal-pane kermit-frame)))
  1075.                                          (send kterm-state
  1076.                                                ':make-connection
  1077.                                                kermit-serial-stream
  1078.                                                terminal-pane))
  1079.                                      :close)
  1080.                                  ;; well, you may want to use this condition some day, probably to
  1081.                                  ;; kill the serial stream. so keep this around.
  1082.                                  )
  1083.                                 (t nil)))
  1084.              (setf kermit-connected-flag nil))))
  1085.           (t (ferror nil "kermit-serial-stream is NIL."))))
  1086.  
  1087.  
  1088.  
  1089.  
  1090.  
  1091.  
  1092.  
  1093.  
  1094.  
  1095.  
  1096.  
  1097.  
  1098. ;;;; Bye
  1099.  
  1100. (defun bye-server ()
  1101.   (cond
  1102.     ((not kermit-serial-stream)
  1103.      (ferror nil "kermit-serial-stream is NIL."))
  1104.     (kermit-connected-flag
  1105.      (beep)
  1106.      (format t "~%You must disconnect in order to say BYE.~%"))
  1107.     (t
  1108.      (with-status ("Bye Server")
  1109.        (send kstate
  1110.                ':bye-server
  1111.                kermit-serial-stream)))))
  1112.  
  1113.  
  1114. ;;;; Finish
  1115.  
  1116. (defun finish-server ()
  1117.   (cond
  1118.     ((not kermit-serial-stream)
  1119.      (ferror nil "kermit-serial-stream is NIL."))
  1120.     (kermit-connected-flag
  1121.      (beep)
  1122.      (format t "~%You must disconnect in order to say BYE.~%"))
  1123.     (t
  1124.      (with-status ("Finish Server")
  1125.        (send kstate
  1126.                ':finish-server
  1127.                kermit-serial-stream)))))
  1128.  
  1129.  
  1130.  
  1131.  
  1132.  
  1133.  
  1134.  
  1135. (defun refresh-windows ()
  1136.   (send kermit-frame :send-all-exposed-panes :clear-screen)
  1137.   (send (send kermit-frame :get-pane 'command-pane) :refresh))
  1138.  
  1139.  
  1140. (defconst all-baud-choices-items-alist
  1141.             '((" 50.      " 50.)
  1142.               (" 75.      " 75.)
  1143.               (" 110.     " 110.)
  1144.               (" 134.     " 134.)
  1145.               (" 150.     " 150.)
  1146.               (" 300.     " 300.)
  1147.               (" 600.     " 600.)
  1148.               (" 1200.    " 1200.)
  1149.               (" 1800.    " 1800.)
  1150.               (" 2000.    " 2000.)
  1151.               (" 2400.    " 2400.)
  1152.               (" 3600.    " 3600.)
  1153.               (" 4800.    " 4800.)
  1154.               (" 7200.    " 7200.)
  1155.               (" 9600.    " 9600.)
  1156.               (" 19200.   " 19200.)))
  1157.  
  1158.  
  1159. (defun set-current-baud-rate (new-baud)        ;1; modified this stuff
  1160.   #+LMI (send kermit-serial-stream
  1161.            :send-if-handles
  1162.            :set-baud-rate
  1163.            new-baud)
  1164.   #-LMI (send kermit-serial-stream
  1165.            :send-if-handles
  1166.            :put
  1167.            :baud
  1168.            new-baud))
  1169.  
  1170. (defun current-baud-rate ()
  1171.   (cond (kermit-serial-stream
  1172.      (lexpr-send
  1173.        kermit-serial-stream
  1174.        :send-if-handles
  1175.        #+LMI (list :baud-rate)
  1176.        #-LMI (list :get :baud)))))
  1177.  
  1178. (defun set-baud-rate ()
  1179.   (let ((base 10.) (*nopoint nil))                ;just for printing
  1180.     (cond
  1181.       (kermit-serial-stream
  1182.        (let ((old-baud (current-baud-rate)))
  1183.            (with-status ("Change Baud~%Old Baud Rate: ~S" old-baud)
  1184.              (let ((new-baud
  1185.                        (tv:menu-choose
  1186.                          all-baud-choices-items-alist
  1187.                          "Choose the Baud Rate:"
  1188.                          '(:mouse)
  1189.                          nil
  1190.                          terminal-pane)))
  1191.                (cond ((and new-baud               ; nil if they move out of the window
  1192.                                (not (= old-baud new-baud))) ;really have to change it
  1193.                         (set-current-baud-rate new-baud)
  1194.                         (format t "~&New Baud Rate: ~S~%" new-baud)))))))
  1195.       (t (ferror nil "kermit-serial-stream is NIL.")))))
  1196.  
  1197.  
  1198.  
  1199. (defun review-parameters ()
  1200.   (with-status ("Review Parameters")
  1201.     (send kstate :set-params)))
  1202.  
  1203.  
  1204. (defun list-user-directory ()            ;1; another problem with with-help-stream here.
  1205.   (with-status ("List Directory:~A"
  1206.         (format nil "~%   ~A"
  1207.             (send kstate :kermit-default-pathname)))
  1208.                         ;1; for now, let's just send it to terminal-io
  1209.            #-3600 (si:with-help-stream (stream :superior terminal-pane)
  1210.                        (listf (send kstate :kermit-default-pathname) stream))
  1211.            #+3600 (with-kermit-typeout-stream
  1212.             stream
  1213.             `(:string ,(send kstate :kermit-default-pathname) :font fonts:metsi :top)
  1214.             (listf (send kstate :kermit-default-pathname) stream))
  1215.            ))
  1216.  
  1217.  
  1218.  
  1219. (defun restart-program (&aux really?)
  1220.   ;; do without status. maybe there's an emergency.
  1221.   (setq really?
  1222.           (y-or-n-p (format nil "~&Do you really want to restart and reinitialize Kermit?")))
  1223.   (cond (really?
  1224.            (refresh-windows)
  1225.            (setf kermit-ready-for-commands? nil)
  1226.            (send command-pane :set-highlighted-items '())
  1227.            (and kermit-serial-stream
  1228.                 (progn (send kermit-serial-stream :close :abort)))
  1229.            (setf kermit-connected-flag nil)
  1230.            (funcall command-pane :set-item-list all-kermit-command-pane-items)
  1231.            (send status-pane :set-label status-pane-label)
  1232.            (process-reset-and-enable current-process))))
  1233.  
  1234. (defconst *unanticipated-chars* nil
  1235.   "Stores unanticipated characters input to the kermit frame
  1236. for later scientific analysis?")
  1237.  
  1238.  
  1239. (defun handle-unanticipated-terminal-input (char)
  1240.  (push char *unanticipated-chars*)
  1241.  (beep))
  1242.  
  1243.  
  1244. ;;;; top-level
  1245.  
  1246. (defun run-kermit-process (kermit-frame-instance)
  1247.   (setq kermit-frame kermit-frame-instance)
  1248.   (kermit-initial-function kermit-frame-instance))
  1249.  
  1250.  
  1251.  
  1252.  
  1253. (defun kermit-initial-function (kermit-frame)
  1254.   (funcall kermit-frame :top-level kermit-frame))
  1255.  
  1256. (defmethod (kermit-frame :close-serial-stream) ()
  1257.   (when kermit-serial-stream
  1258.     (send kermit-serial-stream ':close ':abort)
  1259.     (setq kermit-serial-stream nil)))
  1260.  
  1261. (defmethod (kermit-frame :top-level) (kermit-frame)
  1262.   (let ((status-pane (funcall kermit-frame :get-pane 'status-pane))
  1263.           (command-pane (funcall kermit-frame :get-pane 'command-pane))
  1264.           (interaction-pane (funcall kermit-frame :get-pane 'interaction-pane))
  1265.           (terminal-pane (funcall kermit-frame :get-pane 'terminal-pane))
  1266.           (debug-pane (funcall kermit-frame :get-pane 'interaction-pane))
  1267.           (ibase 10.) ;;;?? worry about this base
  1268.           (base 10.))
  1269.  
  1270.     (let ((terminal-io interaction-pane)
  1271.             (standard-input interaction-pane)
  1272.             (standard-output interaction-pane)
  1273.             (query-io interaction-pane)
  1274.             (trace-output interaction-pane)
  1275.             (error-output interaction-pane)
  1276.             (debug-io debug-pane)
  1277.         )
  1278.  
  1279.       ;; if kermit is not yet ready to accept commands, either because it is
  1280.       ;; just being started up or because a reset or warm boot has been done
  1281.       ;; before it was ready for commands, do various initialization actions.
  1282.  
  1283.       (make-kermit-ready-for-commands)        ;1; changed... see def of this function below
  1284.  
  1285.       ;; this is kermit's top-level command execution loop.
  1286.  
  1287.  
  1288.       (error-restart-loop (sys:abort "Restart Kermit process")
  1289.           (loop as character = (funcall terminal-io :any-tyi)
  1290.                 as command?
  1291.                 = (cond
  1292.                       ((and (not (atom character))
  1293.                               (eq (car character) :menu))
  1294.                        (cadr character)))
  1295.                 doing
  1296.         ;1; The 3600 hates to have you reopen an open serial stream, and I had
  1297.         ;1; some special tests in the following cond to avoid that, but later
  1298.         ;1; changed it back and put the burden of checking on the open forms.
  1299.         (cond               
  1300.           ((memq (get command? :funcall) all-commands-requiring-kermit-serial-stream)
  1301.              (setq kermit-serial-stream (eval serial-stream-open-form))
  1302.              (funcall command-pane :execute command?))
  1303.                     (command?
  1304.                      (funcall command-pane :execute command?))
  1305.             ;1; added the following check to avoid errors for mouse blips
  1306.             ;1; in panes other than the command pane...
  1307.             #+3600
  1308.             ((listp character)        ;1; to catch other mouse blips
  1309.              (handle-unanticipated-terminal-input character))
  1310.             ((= character #-3600 #\hand-down #+3600 #\super-l)    ;1; L for Larger
  1311.              (send kermit-frame ':set-configuration 'long-terminal)
  1312.              #+3600 (refresh-windows))
  1313.             ((= character #-3600 #\hand-up #+3600 #\super-s)    ;1; S for Standard
  1314.              (send kermit-frame ':set-configuration 'default)
  1315.              #+3600 (refresh-windows))
  1316.             #+3600
  1317.             ((= character #\super-p)                            ;1; P for Portrait
  1318.              (send kermit-frame :set-configuration 'portrait-terminal)
  1319.              (refresh-windows))
  1320.                     (t 
  1321.              (handle-unanticipated-terminal-input character))))))))
  1322.  
  1323.  
  1324. ;1; I added this since I needed to get kstate bound earlier in order to avoid
  1325. ;1; an unbound error in (:method kermit-frame :before :select).
  1326.  
  1327. (defun make-kermit-ready-for-commands ()
  1328.   (cond
  1329.     ((not kermit-ready-for-commands?)
  1330.      (setq kterm-state (make-instance 'kterm-state))
  1331.      (setq kstate (make-instance 'kstate)) ;have kstate bound to a kstate instance
  1332.      (setf kermit-ready-for-commands? t))))
  1333.  
  1334.  
  1335. (compile-flavor-methods kermit-frame
  1336.                               kermit-status-pane
  1337.                               kermit-interaction-pane
  1338.                               kermit-command-pane
  1339.                               kermit-terminal-pane)
  1340.